perm filename FFT8X.MAC[SYS,ALS] blob
sn#001159 filedate 1972-04-04 generic text, type T, neo UTF8
00010 TITLE FRXFM
00020 ; FAST FOURIER TRANSFORM 842 FOR N=2**N2POW
00030 ; THIS PROGRAM REPLACES THE VECTOR Z=X+IY BY ITS FINITE
00040 ; DISCRETE, COMPLEX FOURIER TRANSFORM. IT PERFORMS AS MANY BASE
00050 ; 8 ITERATIONS AS POSSIBLE AND THEN FINISHES WITH A BASE 4
00060 ; ITERATION OR A BASE 2 ITERATION IF NEEDED.
00070 ;
00080 ; THE SUBROUTINE IS CALLED AS SUBROUTINE FRXFM(N2POW,X,Y)
00090 ; THE INTEGER N2POW (WHERE N=2**N2POW), THE N REAL LOCATION
00100 ; ARRAY X, AND THE N REAL LOCATION ARRAY Y MUST BE SUPPLIED
00110 ; TO THE SUBROUTINE.
00120 ;
00130 ; THE EXECUTION TIME OF THE ORIGINAL FORTRAN VERSION OF THIS
00140 ; PROGRAM FOR N=1024 WAS APPROXIMATELY 0.6 SECONDS ON THE
00150 ; G.E. 635 COMPUTER. THE TIME FOR THE FOLLOWING MACRO VERSION
00160 ; IS 0.45 SECONDS ON THE DIGITAL EQUIPMENT CORPORATION PDP-10,
00170 ; WHERE TIME=50*(N*N2POW) MICROSECONDS.
00180 ;
00190 ; THIS WORK MADE USE OF ARPA GRANT AF30(602)-4277 AT THE
00200 ; UNIVERSITY OF UTAH (APRIL, 1970).
00210 ;
00220 ; COMMENTS BY D. OESTREICHER (APRIL, 1971)
00230 ; SLIGHT MODIFICATIONS ALSO
00240 ;
00250 ; THE VARIABLE NAMES IN THE COMMENTS REFER TO VARIABLE
00260 ; NAMES USED IN THE ABOVE MENTIONED FORTRAN PROGRAM.
00270 ;
00280 ENTRY FRXFM
00290 EXTERN FLOAT,COS,SIN
00300 FRXFM: 0
00310 MOVEM 17,SAVE+17
00320 MOVE 17,[XWD 0,SAVE]
00330 BLT 17,SAVE+16
00340 MOVE 0,@0(16)
00350 HRRM 0,N2POWA ;INITAILIZE IMMED. CONST. N2POW
00360 HRRM 0,N2POWB ;INITAILIZE IMMED. CONST. N2POW
00370 HRRM 0,N2POWC ;INITAILIZE IMMED. CONST. N2POW
00380 HRRM 0,N2POWD ;INITAILIZE IMMED. CONST. N2POW
00390 MOVE 0,1(16)
00400 HRRM 0,LOP$1 ;INITIALIZE IMMED. CONST. PTR TO X ARRAY
00410 HRRM 0,LOP$3 ;INITIALIZE IMMED. CONST. PTR TO X ARRAY
00420 HRRM 0,LOP$5 ;INITIALIZE IMMED. CONST. PTR TO X ARRAY
00430 SUBI 0,1
00440 MOVEM 0,X#
00450 HRRM 0,R2CR0A
00460 HRRM 0,R2CR0B
00470 HRRM 0,R4CR0A
00480 HRRM 0,R4CR0B
00490 HRRM 0,R8CR0A
00500 HRRM 0,R8CR0B
00510 ADDI 0,1
00520 HRRM 0,R2CR1A
00530 HRRM 0,R2CR1B
00540 HRRM 0,R4CR1A
00550 HRRM 0,R4CR1B
00560 ADDI 0,1
00570 HRRM 0,R4CR2A
00580 HRRM 0,R4CR2B
00590 HRRM 0,R4CR2C
00600 ADDI 0,1
00610 HRRM 0,R4CR3A
00620 HRRM 0,R4CR3B
00630 HRRM 0,R4CR3C
00640 MOVE 0,2(16)
00650 HRRM 0,LOP$2 ;INITIALIZE IMMED. CONST. PTR TO Y ARRAY
00660 HRRM 0,LOP$4 ;INITIALIZE IMMED. CONST. PTR TO Y ARRAY
00670 HRRM 0,LOP$6 ;INITIALIZE IMMED. CONST. PTR TO Y ARRAY
00680 SUBI 0,1
00690 MOVEM 0,Y#
00700 HRRM 0,R2CI0A
00710 HRRM 0,R2CI0B
00720 HRRM 0,R4CI0A
00730 HRRM 0,R4CI0B
00740 HRRM 0,R8CI0A
00750 HRRM 0,R8CI0B
00760 ADDI 0,1
00770 HRRM 0,R2CI1A
00780 HRRM 0,R2CI1B
00790 HRRM 0,R4CI1A
00800 HRRM 0,R4CI1B
00810 ADDI 0,1
00820 HRRM 0,R4CI2A
00830 HRRM 0,R4CI2B
00840 HRRM 0,R4CI2C
00850 ADDI 0,1
00860 HRRM 0,R4CI3A
00870 HRRM 0,R4CI3B
00880 HRRM 0,R4CI3C
00890 MOVEI 0,1
00900 N2POWA: LSH 0,.-. ;MODIFIED TO CONST. N2POW
00910 HRRM 0,NTHPOA ;INITIALIZE IMMED. CONST. NTHPO
00920 HRRM 0,NTHPOB ;INITIALIZE IMMED. CONST. NTHPO
00930 HRRM 0,NTHPOC ;INITIALIZE IMMED. CONST. NTHPO
00940 HRRM 0,NTHPOD ;INITIALIZE IMMED. CONST. NTHPO
00950 N2POWB: MOVEI 1,.-. ;MODIFIED TO CONST. N2POW
00960 IDIVI 1,3
00970 HRRM 1,N8POWA ;INITIALIZE IMMED. CONST. N8POW
00980 HRRM 1,N8POWB ;INITIALIZE IMMED. CONST. N8POW
00990 JUMPE 1,P3
01000 MOVEI 15,1
01010 ;***ALL CODE ABOVE IS EXECUTED ONLY ONCE AS INITIALIZATION***
00010 LOOP1: MOVEM 15,IPASS#
00020 IMUL 15,[-3]
00030 N2POWC: ADDI 15,.-. ;MODIFIED TO CONST. N2POW
00040 MOVEI 3,1
00050 LSH 3,@15
00060 MOVEM 3,NXTLT#
00070 SUBI 3,1
00080 HRRM 3,NXTLTA ;INIT. IMMED. VAR. NXTLT-1
00090 ADDI 3,1
00100 ASH 3,3
00110 MOVEM 3,LENGT#
00120 HRRM 3,LENGTA ;INIT. IMMED. VAR. LENGT
00130 JRST R8TX
00135
00137
00140 CONT8: MOVE 15,IPASS
00150 N8POWA: CAIGE 15,.-. ;INITED TO IMMED. CONST. N8POW
00160 AOJA 15,LOOP1
00170 P3:
00180 N8POWB: MOVNI 4,.-. ;INITED TO IMMED. CONST. N8POW
00190 IMULI 4,3
00200 N2POWD: ADDI 4,.-. ;MODIFIED TO CONST. N2POW
00210 SUBI 4,1
00220 JUMPL 4,P5
00230 JUMPG 4,P7
00240 JRST R2TX
00250 P7: JRST R4TX
00260 JRST FINISH
00270
00280
00290 R2TX: MOVEI 15,1
00300 R2TXL:
00310 R2CR0A: MOVE 1,.-.(15) ; 1=CR0
00320 R2CR1A: MOVE 2,.-.(15) ; 2=CR1
00330 R2CR0B: FADRM 2,.-.(15) ; CR0=CR1+CR0
00340 R2CR1B: FSBRM 1,.-.(15) ; CR1=CR0-CR1
00350 R2CI0A: MOVE 1,.-.(15) ; 1=CI0
00360 R2CI1A: MOVE 2,.-.(15) ; 2=CI2
00370 R2CI0B: FADRM 2,.-.(15) ; CI0=CI1+CI0
00380 R2CI1B: FSBRM 1,.-.(15) ; CI1=CI0-CI1
00390 ADDI 15,2
00400 NTHPOA: CAIG 15,.-. ;INITED TO IMMED. CONST. NTHPO
00410 JRST R2TXL
00420 JRST P5
00430
00440
00450 R4TX: MOVEI 15,1
00460 R4TXL:
00470 R4CR0A: MOVE 1,.-.(15) ; 1=CR0
00480 R4CR2A: FADR 1,.-.(15) ; 1=R1=CR0+CR2
00490 R4CR1A: MOVE 2,.-.(15) ; 2=CR1
00500 R4CR3A: FADR 2,.-.(15) ; 2=R3=CR1+CR3
00510 R4CI0A: MOVE 3,.-.(15) ; 3=CI0
00520 R4CI2A: FADR 3,.-.(15) ; 3=FI1=CI0+CI2
00530 R4CI1A: MOVE 4,.-.(15) ; 4=CI1
00540 R4CI3A: FADR 4,.-.(15) ; 4=FI3=CI1+CI3
00550 MOVE 5,1 ; 5=R1
00560 FADR 5,2 ;** 5=CR0=R1+R3
00570 FSBR 1,2 ;** 1=CR1=R1-R3
00580 MOVE 2,3 ; 2=FI1
00590 FADR 2,4 ;** 2=CI0=FI1+FI3
00600 FSBR 3,4 ;** 3=CI1=FI1-FI3
00610 R4CR0B: EXCH 5,.-.(15) ;* 5=CR0
00620 R4CR1B: EXCH 1,.-.(15) ;* 1=CR1
00630 R4CI0B: EXCH 2,.-.(15) ;* 2=CI0
00640 R4CI1B: EXCH 3,.-.(15) ;* 3=CI1
00650 R4CR2B: FSBR 5,.-.(15) ; 5=R2=CR0-CR2
00660 R4CR3B: FSBR 1,.-.(15) ; 1=R4=CR1-CR3
00670 R4CI2B: FSBRB 2,.-.(15) ; 2=CI2=FI2=CI0-CI2
00680 R4CI3B: FSBR 3,.-.(15) ; 3=FI4=CI1-CI3
00690 MOVE 4,5 ; 4=R2
00700 FSBR 4,3 ;** 4=CR2=R2-FI4
00710 FADR 5,3 ;** 5=CR3=R2+FI4
00720 R4CI2C: FADRM 1,.-.(15) ;*CI2=R4+FI2
00730 FSBR 2,1 ;** 2=CI3=FI2-R4
00740 R4CR2C: MOVEM 4,.-.(15) ;* 4=CR2
00750 R4CR3C: MOVEM 5,.-.(15) ;* 5=CR3
00760 R4CI3C: MOVEM 2,.-.(15) ;* 2=CI3
00770 ADDI 15,4
00780 NTHPOB: CAIG 15,.-. ;INITED TO IMMED. CONST. NTHPO
00790 JRST R4TXL
00800 JRST P5
00810
00820
00830 R8TX: MOVE 0,X
00840 ADD 0,NXTLT
00850 HRRM 0,R8CR1A
00860 HRRM 0,R8CR1B
00870 ADD 0,NXTLT
00880 HRRM 0,R8CR2A
00890 HRRM 0,R8CR2B
00900 ADD 0,NXTLT
00910 HRRM 0,R8CR3A
00920 HRRM 0,R8CR3B
00930 ADD 0,NXTLT
00940 HRRM 0,R8CR4A
00950 HRRM 0,R8CR4B
00960 HRRM 0,R8CR4C
00970 ADD 0,NXTLT
00980 HRRM 0,R8CR5A
00990 HRRM 0,R8CR5B
01000 HRRM 0,R8CR5C
01010 ADD 0,NXTLT
01020 HRRM 0,R8CR6A
01030 HRRM 0,R8CR6B
01040 HRRM 0,R8CR6C
01050 ADD 0,NXTLT
01060 HRRM 0,R8CR7A
01070 HRRM 0,R8CR7B
01080 HRRM 0,R8CR7C
01090 MOVE 0,Y
01100 ADD 0,NXTLT
01110 HRRM 0,R8CI1A
01120 HRRM 0,R8CI1B
01130 ADD 0,NXTLT
01140 HRRM 0,R8CI2A
01150 HRRM 0,R8CI2B
01160 ADD 0,NXTLT
01170 HRRM 0,R8CI3A
01180 HRRM 0,R8CI3B
01190 ADD 0,NXTLT
01200 HRRM 0,R8CI4A
01210 HRRM 0,R8CI4B
01220 HRRM 0,R8CI4C
01230 ADD 0,NXTLT
01240 HRRM 0,R8CI5A
01250 HRRM 0,R8CI5B
01260 HRRM 0,R8CI5C
01270 ADD 0,NXTLT
01280 HRRM 0,R8CI6A
01290 HRRM 0,R8CI6B
01300 HRRM 0,R8CI6C
01310 ADD 0,NXTLT
01320 HRRM 0,R8CI7A
01330 HRRM 0,R8CI7B
01340 HRRM 0,R8CI7C
01350 MOVE 4,[6.283185307]
01360 JSA 16,FLOAT ;ONE OF TWO CALLS ON FLOAT
01370 ARG LENGT
01380 FDVR 4,0
01390 MOVEM 4,SCALE#
01400
01410 ;ACCUMULATORS
01420 AC0=0
01430 AC1=1
01440 AC2=2
01450 AC3=3
01460 AC4=4
01470 AC5=5
01480 AC6=6
01490 AC7=7
01500 AC10=10
01510 AC11=11
01520 AC12=12
01530 AC13=13
01540 ACJ=14
01550 ACK=15
01560 ACR2=16
01570 ACMR2=17
01580
01590 MOVEI ACJ,0 ;INIT J
01600 MOVE ACR2,[0.7071067812] ;SETUP ACR2
01610 MOVN ACMR2,ACR2 ;SETUP ACMR2
01620 MOVEI ACK,1(ACJ) ;SETUP K
01630 JRST LOOPK ;FAST START
01640
01650 LOOPJ: MOVEM ACJ,J# ;SAVE J
01660 FSC ACJ,233 ;FLOAT J
01670 FMPR ACJ,SCALE ;MAKE ANGLE
01680 MOVEM ACJ,ARGUM# ;SAVE FOR SIN AND COS
01690 JSA 16,COS
01700 ARG ARGUM
01710 MOVEM 0,C1#
01720 JSA 16,SIN
01730 ARG ARGUM
01740 MOVEM 0,S1#
01750 ;AC0=S1
01760 MOVE AC1,AC0 ; AC1=S1
01770 MOVE AC2,AC1 ; AC2=S1
01780 MOVE AC3,C1 ; AC3=C1
01790 MOVE AC4,AC3 ; AC4=C1
01800 MOVE AC5,AC4 ; AC5=C1
01810 MOVE AC6,AC5 ; AC6=C1
01820 FMPR AC3,AC0 ; AC3=S1*C1
01830 FADR AC3,AC3 ; AC3=S2=2*S1*C1
01840 MOVEM AC3,S2# ;STORE
01850 FMPR AC0,AC1 ; AC0=S1*S1
01860 FMPR AC4,AC5 ; AC4=C1*C1
01870 FSBRB AC4,AC0 ; AC0=AC4=C2=C1*C1-S1*S1
01880 MOVEM AC0,C2# ;STORE
01890 FMPR AC2,AC0 ; AC2=S1*C2
01900 FMPR AC6,AC3 ; AC6=C1*S2
01910 FADRB AC2,AC6 ; AC2=AC6=S3=S1*C2+C1*S2
01920 MOVEM AC2,S3# ;STORE
01930 FMPR AC5,AC0 ; AC5=C1*C2
01940 FMPR AC1,AC3 ; AC1=S1*S2
01950 FSBRB AC5,AC1 ; AC5=AC1=C3=C1*C2-S1*S2
01960 MOVEM AC5,C3# ;STORE
01970 MOVE AC7,AC3 ; AC7=S2
01980 FMPR AC7,AC1 ; AC7=S2*C3
01990 FMPR AC2,AC0 ; AC2=S3*C2
02000 FADR AC7,AC2 ; AC7=S5=S2*C3+S3*C2
02010 MOVEM AC7,S5# ;STORE
02020 MOVE AC7,AC3 ; AC7=S2
02030 MOVE AC2,AC0 ; AC2=C2
02040 FMPR AC2,AC5 ; AC2=C2*C3
02050 FMPR AC7,AC6 ; AC7=S2*S3
02060 FSBR AC2,AC7 ; AC2=C5=C2*C3-S2*S3
02070 MOVEM AC2,C5# ;STORE
02080 FMPR AC4,AC3 ; AC4=C2*S2
02090 FADR AC4,AC4 ; AC4=S4=2*C2*S2
02100 MOVEM AC4,S4# ;STORE
02110 FMPR AC0,AC0 ; AC0=C2*C2
02120 FMPR AC3,AC3 ; AC3=S2*S2
02130 FSBRB AC0,AC3 ; AC0=AC3=C4=C2*C2-S2*S2
02140 MOVEM AC0,C4# ;STORE
02150 MOVE AC7,AC4 ; AC7=S4
02160 FMPR AC3,AC6 ; AC3=C4*S3
02170 FMPR AC7,AC5 ; AC7=S4*C3
02180 FADR AC3,AC7 ; AC3=S7=C4*S3+S4*C3
02190 MOVEM AC3,S7# ;STORE
02200 FMPR AC0,AC5 ; AC0=C4*C3
02210 FMPR AC4,AC6 ; AC4=S4*S3
02220 FSBR AC0,AC4 ; AC0=C7=C4*C3-S4*S3
02230 MOVEM AC0,C7# ;STORE
02240 FMPR AC1,AC6 ; AC1=C3*S3
02250 FADR AC1,AC1 ; AC1=S6=2*C3*S3
02260 MOVEM AC1,S6# ;STORE
02270 FMPR AC5,AC5 ; AC5=C3*C3
02280 FMPR AC6,AC6 ; AC6=S3*S3
02290 FSBR AC5,AC6 ; AC5=C6=C3*C3-S3*S3
02300 MOVEM AC5,C6# ;STORE
02310 MOVE ACJ,J ;RESET J
02320 MOVE ACR2,[0.7071067812] ;RESET ACR2
02330 MOVN ACMR2,ACR2 ;SETUP ACMR2
02340 MOVEI ACK,1(ACJ) ;SETUP K
02350
02360 LOOPK:
02370 ;INNER-MOST LOOP F0R RADIX 8 ITERATI0N
02380 R8CR0A: MOVE AC0,.-.(ACK) ;CR0+CR4
02390 R8CR4A: FADR AC0,.-.(ACK) ; AC0=AR0
02400 R8CR1A: MOVE AC1,.-.(ACK) ;CR1+CR5
02410 R8CR5A: FADR AC1,.-.(ACK) ; AC1=AR1
02420 R8CR2A: MOVE AC2,.-.(ACK) ;CR2+CR6
02430 R8CR6A: FADR AC2,.-.(ACK) ; AC2=AR2
02440 R8CR3A: MOVE AC3,.-.(ACK) ;CR3+CR7
02450 R8CR7A: FADR AC3,.-.(ACK) ; AC3=AR3
02460 R8CI0A: MOVE AC4,.-.(ACK) ;CI0+CI4
02470 R8CI4A: FADR AC4,.-.(ACK) ; AC4=AI0
02480 R8CI1A: MOVE AC5,.-.(ACK) ;CI1+CI5
02490 R8CI5A: FADR AC5,.-.(ACK) ; AC5=AI1
02500 R8CI2A: MOVE AC6,.-.(ACK) ;CI2+CI6
02510 R8CI6A: FADR AC6,.-.(ACK) ; AC6=AI2
02520 R8CI3A: MOVE AC7,.-.(ACK) ;CI3+CI7
02530 R8CI7A: FADR AC7,.-.(ACK) ; AC7=AI3
02540 MOVE AC10,AC0 ; AC10=AR0
02550 MOVE AC11,AC1 ; AC11=AR1
02560 MOVE AC12,AC4 ; AC12=AI0
02570 MOVE AC13,AC5 ; AC13=AI1
02580 FADR AC10,AC2 ; AC10=BR0=AR0+AR2
02590 FSBR AC11,AC3 ; AC11=BR3=AR1-AR3
02600 FADR AC12,AC6 ; AC12=BI0=AI0+AI2
02610 FSBR AC13,AC7 ; AC13=BI3=AI1-AI3
02620 FSBRB AC0,AC2 ; AC0=AC2=BR2=AR0-AR2
02630 FADRB AC1,AC3 ; AC1=AC3=BR1=AR1+AR3
02640 FSBRB AC4,AC6 ; AC4=AC6=BI2=AI0-AI2
02650 FADRB AC5,AC7 ; AC5=AC7=BI1=AI1+AI3
02660 FADR AC1,AC10 ;** AC1=CR0=BR1+BR0
02670 FADR AC5,AC12 ;** AC5=CI0=BI1+BI0
02680 JUMPE ACJ,R8J0A ;J=0 SPECIAL CASE
02690 FSBRB AC12,AC7 ; AC12=AC7=BI0-BI1
02700 FSBRB AC10,AC3 ; AC10=AC3=BR0-BR1
02710 FMPR AC10,C4 ; AC10=C4*(BR0-BR1)
02720 FMPR AC3,S4 ; AC3=S4*(BR0-BR1)
02730 FMPR AC12,C4 ; AC12=C4*(BI0-BI1)
02740 FMPR AC7,S4 ; AC7=S4*(BI0-BI1)
02750 FSBR AC10,AC7 ;** AC10=CR1
02760 FADR AC12,AC3 ;** AC12=CI1
02770 FSBR AC0,AC13 ; AC0=BR2-BI3
02780 MOVE AC7,AC0 ;=AC7
02790 FADRB AC2,AC13 ; AC2=AC13=BR2+BI3
02800 FSBR AC4,AC11 ; AC4=BI2-BR3
02810 MOVE AC3,AC4 ;=AC3
02820 FADRB AC6,AC11 ; AC6=AC11=BI2+BR3
02830 FMPR AC0,C2 ; AC0=C2*(BR2-BI3)
02840 FMPR AC6,S2 ; AC6=S2*(BI2+BR3)
02850 FMPR AC11,C2 ; AC11=C2*(BI2+BR3)
02860 FMPR AC7,S2 ; AC7=S2*(BR2-BI3)
02870 FMPR AC13,C6 ; AC13=C6*(BR2+BI3)
02880 FMPR AC3,S6 ; AC3=S6*(BI2-BR3)
02890 FMPR AC4,C6 ; AC4=C6*(BI2-BR3)
02900 FMPR AC2,S6 ; AC2=S6*(BR2+BI3)
02910 FSBR AC0,AC6 ;** AC0=CR2
02920 FADR AC11,AC7 ;** AC11=CI2
02930 FSBR AC13,AC3 ;** AC13=CR3
02940 FADR AC4,AC2 ;** AC4=CI3
02950 R8JXA:
02960 R8CR0B: EXCH AC1,.-.(ACK) ;* AC1=CR0
02970 R8CR1B: EXCH AC10,.-.(ACK) ;* AC10=CR1
02980 R8CR2B: EXCH AC0,.-.(ACK) ;* AC0=CR2
02990 R8CR3B: EXCH AC13,.-.(ACK) ;* AC13=CR3
03000 R8CI0B: EXCH AC5,.-.(ACK) ;* AC5=CI0
03010 R8CI1B: EXCH AC12,.-.(ACK) ;* AC12=CI1
03020 R8CI2B: EXCH AC11,.-.(ACK) ;* AC11=CI2
03030 R8CI3B: EXCH AC4,.-.(ACK) ;* AC4=CI3
03040 R8CR4B: FSBR AC1,.-.(ACK) ; AC1=AR4
03050 R8CR5B: FSBR AC10,.-.(ACK) ; AC10=AR5
03060 R8CR6B: FSBR AC0,.-.(ACK) ; AC0=AR6
03070 R8CR7B: FSBR AC13,.-.(ACK) ; AC13=AR7
03080 R8CI4B: FSBR AC5,.-.(ACK) ; AC5=AI4
03090 R8CI5B: FSBR AC12,.-.(ACK) ; AC12=AI5
03100 R8CI6B: FSBR AC11,.-.(ACK) ; AC11=AI6
03110 R8CI7B: FSBR AC4,.-.(ACK) ; AC4=AI7
03120 MOVE AC2,AC1 ; AC2=AR4
03130 MOVE AC3,AC10 ; AC3=AR5
03140 MOVE AC6,AC5 ; AC6=AI4
03150 MOVE AC7,AC12 ; AC7=AI5
03160 FADR AC1,AC11 ; AC1=BR6=AR4+AI6
03170 FSBRB AC2,AC11 ; AC2=AC11=BR4=AR4-AI6
03180 FADR AC3,AC4 ; AC3=BR7=AR5+AI7
03190 FSBRB AC10,AC4 ; AC4=AC10=BR5=AR5-AI7
03200 FSBR AC6,AC0 ; AC6=BI6=AI4-AR6
03210 FADRB AC5,AC0 ; AC5=AC0=BI4=AI4+AR6
03220 FSBR AC7,AC13 ; AC7=BI7=AI5-AR7
03230 FADR AC12,AC13 ; AC12=BI5=AI5+AR7
03240 FSBR AC4,AC12 ; AC4=BR5-BI5
03250 FADR AC10,AC12 ; AC10=BR5+BI5
03260 FMPR AC4,ACR2 ; AC4=TR5
03270 FMPR AC10,ACR2 ; AC10=TI5
03280 MOVE AC12,AC3 ; AC12=BR7
03290 FADR AC12,AC7 ; AC12=BR7+BI7
03300 FSBR AC3,AC7 ; AC3=BR7-BI7
03310 FMPR AC12,ACMR2 ; AC12=TR7
03320 FMPR AC3,ACR2 ; AC3=TI7
03330 JUMPE ACJ,R8J0B ;J=0 SPECIAL CASE
03340 FADR AC2,AC4 ; AC2=BR4+TR5
03350 MOVE AC7,AC2 ;=AC7
03360 FSBRB AC11,AC4 ; AC11=AC4=BR4-TR5
03370 FADR AC5,AC10 ; AC5=BI4+TI5
03380 MOVE AC13,AC5 ;=AC13
03390 FSBRB AC0,AC10 ; AC0=AC10=BI4-TI5
03400 FMPR AC2,C1 ; AC2=C1*(BR4+TR5)
03410 FMPR AC13,S1 ; AC13=S1*(BI4+TI5)
03420 FMPR AC5,C1 ; AC5=C1*(BI4+TI5)
03430 FMPR AC7,S1 ; AC7=S1*(BR4+TR5)
03440 FMPR AC11,C5 ; AC11=C5*(BR4-TR5)
03450 FMPR AC10,S5 ; AC10=S5*(BI4-TI5)
03460 FMPR AC0,C5 ; AC0=C5*(BI4-TI5)
03470 FMPR AC4,S5 ; AC4=S5*(BR4-TR5)
03480 FSBR AC2,AC13 ;** AC2=CR4
03490 FADR AC5,AC7 ;** AC5=CI4
03500 FSBR AC11,AC10 ;** AC11=CR5
03510 FADR AC0,AC4 ;** AC0=CI5
03520 MOVE AC4,AC1 ; AC4=BR6
03530 MOVE AC7,AC6 ; AC7=BI6
03540 FADR AC1,AC12 ; AC1=BR6+TR7
03550 MOVE AC13,AC1 ;=AC13
03560 FADR AC6,AC3 ; AC6=BI6+TI7
03570 MOVE AC10,AC6 ;=AC10
03580 FSBRB AC4,AC12 ; AC4=AC12=BR6-TR7
03590 FSBRB AC7,AC3 ; AC7=AC3=BI6-TI7
03600 FMPR AC1,C3 ; AC1=C3*(BR6+TR7)
03610 FMPR AC10,S3 ; AC10=S3*(BI6+TI7)
03620 FMPR AC6,C3 ; AC6=C3*(BI6+TI7)
03630 FMPR AC13,S3 ; AC13=S3*(BR6+TR7)
03640 FMPR AC4,C7 ; AC4=C7*(BR6-TR7)
03650 FMPR AC3,S7 ; AC3=S7*(BI6-TI7)
03660 FMPR AC7,C7 ; AC7=C7*(BI6-TI7)
03670 FMPR AC12,S7 ; AC12=S7*(BR6-TR7)
03680 FSBR AC1,AC10 ;** AC1=CR6
03690 FADR AC6,AC13 ;** AC6=CI6
03700 FSBR AC4,AC3 ;** AC4=CR7
03710 FADR AC7,AC12 ;** AC7=CI7
03720 R8JXB:
03730 R8CR4C: MOVEM AC2,.-.(ACK) ;* AC2=CR4
03740 R8CR5C: MOVEM AC11,.-.(ACK) ;* AC11=CR5
03750 R8CR6C: MOVEM AC1,.-.(ACK) ;* AC1=CR6
03760 R8CR7C: MOVEM AC4,.-.(ACK) ;* AC4=CR7
03770 R8CI4C: MOVEM AC5,.-.(ACK) ;* AC5=CI4
03780 R8CI5C: MOVEM AC0,.-.(ACK) ;* AC0=CI5
03790 R8CI6C: MOVEM AC6,.-.(ACK) ;* AC6=CI6
03800 R8CI7C: MOVEM AC7,.-.(ACK) ;* AC7=CI7
03810 LENGTA: ADDI ACK,.-. ;INITED TO IMMED. VAR. LENGT BY LOOP1
03820 NTHPOC: CAIG ACK,.-. ;INITED TO IMMED. CONST. NTHPO
03830 JRST LOOPK ;LOOP
03840 NXTLTA: CAIGE ACJ,.-. ;INITED TO IMMED. VAR. NXTLT-1 BY LOOP1
03850 AOJA ACJ,LOOPJ ;LOOP
03860 JRST CONT8 ;CONTINUE
03870
03880
03890 ;J=0 SPECIAL CASE A
03900 R8J0A:
03910 FSBR AC10,AC3 ;** AC10=CR1=BR0-BR1
03920 FSBR AC12,AC7 ;** AC12=CI1=BI0-BI1
03930 FSBR AC0,AC13 ;** AC0=CR2=BR2-BI3
03940 FSBR AC4,AC11 ;** AC4=CI3=BI2-BR3
03950 FADR AC11,AC6 ;** AC11=CI2=BR3+BI2
03960 FADR AC13,AC2 ;** AC13=CR3=BI3+BR2
03970 JRST R8JXA ;CONTINUE
03980
03990 ;J=0 SPECIAL CASE B
04000 R8J0B:
04010 FADR AC2,AC4 ;** AC2=CR4=BR4+TR5
04020 FADR AC5,AC10 ;** AC5=CI4=BI4+TI5
04030 FSBR AC11,AC4 ;** AC11=CR5=BR4-TR5
04040 FSBR AC0,AC10 ;** AC0=CI5=BI4-TI5
04050 MOVE AC4,AC1 ; AC4=BR6
04060 MOVE AC7,AC6 ; AC7=BI6
04070 FADR AC1,AC12 ;** AC1=CR6=BR6+TR7
04080 FADR AC6,AC3 ;** AC6=CI6=BI6+TI7
04090 FSBR AC4,AC12 ;** AC4=CR7=BR6-TR7
04100 FSBR AC7,AC3 ;** AC7=CI7=BI6-TI7
04110 JRST R8JXB ;CONTINUE
04120
04130 P5:
04140 NTHPOD: MOVEI 1,.-. ;INITED TO IMMED. CONST. NTHPO
04150 SUBI 1,1
04160 MOVE 2,1
04170 MOVE 3,1
04180 SUBI 2,1
04190 LOOP: JFFO 3,.+1
04200 XOR 3,TABLE-25(4)
04210 AND 3,1
04220 CAMG 3,2
04230 JRST BD2
04240 LOP$1: MOVE 5,.-.(3) ;INITED TO IMMED. CONST. PTR TO X ARRAY
04250 LOP$2: MOVE 7,.-.(3) ;INITED TO IMMED. CONST. PTR TO Y ARRAY
04260 LOP$3: EXCH 5,.-.(2) ;INITED TO IMMED. CONST. PTR TO X ARRAY
04270 LOP$4: EXCH 7,.-.(2) ;INITED TO IMMED. CONST. PTR TO Y ARRAY
04280 LOP$5: MOVEM 5,.-.(3) ;INITED TO IMMED. CONST. PTR TO X ARRAY
04290 LOP$6: MOVEM 7,.-.(3) ;INITED TO IMMED. CONST. PTR TO Y ARRAY
04300 BD2: SOJG 2,LOOP
04310 FINISH: MOVE 17,[XWD SAVE,0]
04320 BLT 17,17
04330 JRA 16,3(16)
04340
04350 TABLE: ↑B111111111111111111111100000000000000
04360 ↑B111111111111111111111110000000000000
04370 ↑B111111111111111111111111000000000000
04380 ↑B111111111111111111111111100000000000
04390 ↑B111111111111111111111111110000000000
04400 ↑B111111111111111111111111111000000000
04410 ↑B111111111111111111111111111100000000
04420 ↑B111111111111111111111111111110000000
04430 ↑B111111111111111111111111111111000000
04440 ↑B111111111111111111111111111111100000
04450 ↑B111111111111111111111111111111110000
04460 ↑B111111111111111111111111111111111000
04470 ↑B111111111111111111111111111111111100
04480 ↑B111111111111111111111111111111111110
04490 ↑B111111111111111111111111111111111111
04500 SAVE: BLOCK 20
04510 END